perm filename GAME.LSP[206,JMC] blob sn#075781 filedate 1973-12-04 generic text, type T, neo UTF8

(DEFPROP GAMEFNS
 (GAMEFNS VALMAX
	  VALMIN
	  LINEMAX
	  LINEMIN
	  TREEMAX
	  TREEMIN
	  RECTIFY
	  COMMONTAIL
	  COMMONHEAD)
VALUE)

(DEFPROP VALMAX
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) ALPHA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA))
		  (VALMAX (CDR U) ALPHA BETA))
		 ((LESSP S BETA) (VALMAX (CDR U) S BETA))
		 (T BETA)))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP VALMIN
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) BETA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA)) ALPHA)
		 ((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
		 (T (VALMIN (CDR U) ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
		(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)

(DEFPROP LINEMAX
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS ALPHA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA))
		  (LINEMAX (CDR U) LINE ALPHA BETA))
		 ((LESSP (CAR S) BETA)
		  (LINEMAX (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   (CAR S)
			   BETA))
		 (T (CONS BETA LINE))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMIN (SUCCESSORS (CAR U))
			  (CONS BETA (QUOTE BETA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP LINEMIN
 (LAMBDA(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS BETA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
		 ((LESSP (CAR S) BETA)
		  (LINEMIN (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   ALPHA
			   (CAR S)))
		 (T (LINEMIN (CDR U) LINE ALPHA BETA))))
	  (COND	((TER (RECTIFY (CAR U)) ALPHA BETA)
		 (LIST (IMVAL (CAR U))))
		(T
		 (LINEMAX (SUCCESSORS (CAR U))
			  (CONS ALPHA (QUOTE ALPHA-CUTOFF))
			  ALPHA
			  BETA)))))))
EXPR)

(DEFPROP TREEMAX
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST ALPHA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(TREEMAX (CDR U)
		 TRMAX
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 ALPHA
		 BETA))
       ((LESSP (CAR S) BETA)
	(TREEMAX (CDR U)
		 (CONS (EXT (CAR U)) (CADR S))
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 (CAR S)
		 BETA))
       (T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMIN (SUCCESSORS (CAR U))
		NIL
		(CONS BETA (QUOTE BETA-CUTOFF))
		ALPHA
		BETA)))))))
EXPR)

(DEFPROP TREEMIN
 (LAMBDA(U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST BETA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
       ((LESSP (CAR S) BETA)
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 (CONS (EXT (CAR U)) (CADDR S))
		 ALPHA
		 (CAR S)))
       (T
	(TREEMIN (CDR U)
		 (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		 TRMIN
		 ALPHA
		 BETA))))
     (COND
      ((TER (RECTIFY (CAR U)) ALPHA BETA)
       ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
      (T
       (TREEMAX (SUCCESSORS (CAR U))
		(CONS ALPHA (QUOTE ALPHA-CUTOFF))
		NIL
		ALPHA
		BETA)))))))
EXPR)

(DEFPROP RECTIFY
 (LAMBDA(P)
  (PROG	(Z Q)
	(SETQ Q (COMMONTAIL P P1))
   L1	(COND ((EQUAL Q P1) (GO L2)))
	(REVERT)
	(GO L1)
   L2	(SETQ Z (LISTSUBT P P1))
   L3	(COND ((NULL Z) (RETURN P)))
	(UPDATE (CAR Z))
	(SETQ Z (CDR Z))
	(GO L3)))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)

(DEFPROP COMMONHEAD
 (LAMBDA(U V)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
	(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)